home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 32 / dui.zip / DUI.PAS < prev    next >
Pascal/Delphi Source File  |  1987-02-16  |  10KB  |  276 lines
  1. {$I Graph.P}
  2. {$I Keyboard.Inc}
  3. type PicType=Array[1..100] of Char;
  4.      MapType=Array[1..16,1..16] of char;
  5. Var  Car:Array[1..16] of String[16];
  6.      CarN,CarNE,CarE,CarSE,CarS,CarSW,CarW,CarNW:PicType;
  7.      C:Char;
  8.      Dead, X,Y, I,T, Dir:integer;
  9.      Peds:Array[1..10,1..4] of Integer;
  10. CONST Pat:Array [0..7] of byte = ($FF,$FF,$FF,$FF, $FF,$FF,$FF,$FF);
  11.       Car1 : MapType =
  12.                 ('                ',
  13.                  '       11       ',
  14.                  '      1111      ',
  15.                  '    2 1111 2    ',
  16.                  '    21111112    ',
  17.                  '    2 1111 2    ',
  18.                  '      1111      ',
  19.                  '      1111      ',
  20.                  '     111111     ',
  21.                  '     111111     ',
  22.                  '  22 111111 22  ',
  23.                  '  221111111122  ',
  24.                  '  22 111111 22  ',
  25.                  '     111111     ',
  26.                  '      1111      ',
  27.                  '                ');
  28.       Car2 : MapType =
  29.                 ('                ',
  30.                  '         2   11 ',
  31.                  '        2  1111 ',
  32.                  '       2 11111  ',
  33.                  '         11111  ',
  34.                  '   2    11111   ',
  35.                  '  22   111111 2 ',
  36.                  ' 22  111111  2  ',
  37.                  ' 2 1111111  2   ',
  38.                  '   111111       ',
  39.                  '  1111111       ',
  40.                  ' 1111111        ',
  41.                  ' 1111111 22     ',
  42.                  ' 11111  22      ',
  43.                  '  111  22       ',
  44.                  '                ');
  45.  
  46.  
  47.  
  48.  
  49. Procedure ProcessU(CarMap:MapType; Var Pic:PicType);
  50. var  x,y:integer;
  51. Begin
  52.      FillScreen(0);
  53.      For Y:= 1 to 16 do
  54.          For x:=1 to 16 do
  55.              Case CarMap[y,x] of
  56.                   '1':Plot(x,y,1);
  57.                   '2':Plot(X,y,2);
  58.                   '3':Plot(x,y,3);
  59.                   End;
  60.      getpic(pic, 1,1, 16,16);
  61. End;
  62.  
  63. Procedure ProcessD(CarMap:MapType; Var Pic:PicType);
  64. var  x,y:integer;
  65. Begin
  66.      FillScreen(0);
  67.      For Y:= 1 to 16 do
  68.          For x:=1 to 16 do
  69.              Case CarMap[17-y,x] of
  70.                   '1':Plot(x,y,1);
  71.                   '2':Plot(X,y,2);
  72.                   '3':Plot(x,y,3);
  73.                   End;
  74.      getpic(pic, 1,1, 16,16);
  75. End;
  76.  
  77. Procedure ProcessL(CarMap:MapType; Var Pic:PicType);
  78. var  x,y:integer;
  79. Begin
  80.      FillScreen(0);
  81.      For Y:= 1 to 16 do
  82.          For x:=1 to 16 do
  83.              Case CarMap[x,y] of
  84.                   '1':Plot(x,y,1);
  85.                   '2':Plot(X,y,2);
  86.                   '3':Plot(x,y,3);
  87.                   End;
  88.      getpic(pic, 1,1, 16,16);
  89. End;
  90.  
  91. Procedure ProcessR(CarMap:MapType; Var Pic:PicType);
  92. var  x,y:integer;
  93. Begin
  94.      FillScreen(0);
  95.      For Y:= 1 to 16 do
  96.          For x:=1 to 16 do
  97.              Case CarMap[17-x,17-y] of
  98.                   '1':Plot(x,y,1);
  99.                   '2':Plot(X,y,2);
  100.                   '3':Plot(x,y,3);
  101.                   End;
  102.      getpic(pic, 1,1, 16,16);
  103. End;
  104.  
  105. Procedure ProcessX(CarMap:MapType; Var Pic:PicType);
  106. var  x,y:integer;
  107. Begin
  108.      FillScreen(0);
  109.      For Y:= 1 to 16 do
  110.          For x:=1 to 16 do
  111.              Case CarMap[x,17-y] of
  112.                   '1':Plot(x,y,1);
  113.                   '2':Plot(X,y,2);
  114.                   '3':Plot(x,y,3);
  115.                   End;
  116.      getpic(pic, 1,1, 16,16);
  117. End;
  118.  
  119.  
  120. Procedure Incr(X:integer);
  121. Begin X:=X+1 End;
  122.  
  123. Procedure Decr(X:integer);
  124. Begin X:=X-1 End;
  125.  
  126. Begin
  127.      ClrScr;
  128.      GraphMode;
  129.      Palette(1);
  130.      ProcessU(Car1,CarN);
  131.      ProcessU(Car2,CarNE);
  132.      ProcessR(Car1,CarE);
  133.      ProcessD(Car2,CarSE);
  134.      ProcessD(Car1,CarS);
  135.      ProcessL(Car2,CarSW);
  136.      ProcessL(Car1,CarW);
  137.      ProcessX(Car2,CarNW);
  138.      TextMode(C40);
  139.      TextColor(9);
  140.      Writeln('  ██████████   ██      ██   ████████  ');
  141.      Writeln('   ██      ██  ██      ██      ██     ');
  142.      Writeln('   ██      ██  ██      ██      ██     ');
  143.      Writeln('   ██      ██  ██      ██      ██     ');
  144.      Writeln('   ██      ██  ██      ██      ██     ');
  145.      Writeln('   ██      ██  ██      ██      ██     ');
  146.      Writeln('   ██      ██  ██      ██      ██     ');
  147.      Writeln('  ██████████    ████████    ████████  ');
  148.      TextColor(12);
  149.      Writeln;
  150.      Writeln(' ... A non-violent alternative to     ');
  151.      Writeln('  drinking and driving - by MVT-SOFT  ');
  152.      Writeln;
  153.      Writeln('  The object is to run down all ten   ');
  154.      Writeln('  pedestrians.  Steer your car with   ');
  155.      Writeln('  the left and right arrow keys; the  ');
  156.      Writeln('  "5" key will turn the car around.   ');
  157.      Writeln('  Press ESC to quit.  If you can''t   ');
  158.      Writeln('  catch the pedestrians, you should   ');
  159.      Writeln('  not attempt to drive a real car!    ');
  160.      Writeln;
  161.      Write  ('  Press any key to start..........');
  162.      Repeat Until Keypressed;
  163.      While keypressed do
  164.            read(KBD,c);
  165.      GraphMode;
  166.      FillScreen(0);
  167.      Palette(1);
  168.      Draw(0,8,   319,8,   3);
  169.      Draw(0,199, 319,199, 3);
  170.      Draw(0,8,   0,199,   3);
  171.      Draw(319,8, 319,199, 3);
  172.      GotoXY(1,1);
  173.      Write('MVT-Soft         D.U.I.');
  174.      For I := 1 to 10 do
  175.          Begin
  176.          X := Random(300)+10;
  177.          Y := Random(170)+20;
  178.          Peds[I,1] := X;
  179.          Peds[I,2] := Y;
  180.          Peds[I,3] := Random(3)-1;
  181.          Peds[I,4] := Random(3)-1;
  182.          Plot(X,Y, 3);
  183.          end;
  184.      Dir := 1;
  185.      X := 160;
  186.      Y := 180;
  187.      C := ' ';
  188.      KeySet(NumLok,True);
  189.      Dead := 0;
  190.      Repeat
  191.          For I := 1 to 10 do
  192.              If (Peds[I,1]>=X) and (Peds[I,1]<=X+15) and
  193.                 (Peds[I,2]<=Y) and (Peds[I,2]>=Y-15)
  194.                 Then Begin           { --- He's hit --- }
  195.                      Sound(1500);
  196.                      Delay(50);
  197.                      NoSound;
  198.                      Peds[I,1] := 0; Peds[I,2] := 0;
  199.                      Dead := Dead+1;
  200.                      GotoXY(29,1); Write('Deaths: ',Dead:2);
  201.                      End
  202.                 Else If Peds[I,1]<>0 { --- Else, If he's not already dead --- }
  203.                         Then Begin
  204.                              If (0=Random(50)) or
  205.                                 (30>Abs(7+X-Peds[I,1])+Abs((Y-7)-Peds[I,2]))
  206.                                 Then Repeat
  207.                                         Case Random(2) of
  208.                                              0:Begin
  209.                                                If Peds[I,1]<X
  210.                                                   Then Peds[I,3]:=Random(4)-2
  211.                                                   Else Peds[I,3]:=Random(4)-1;
  212.                                                If Peds[I,3]=-2 then Peds[I,3]:=-1;
  213.                                                If Peds[I,3]= 2 then Peds[I,3]:= 1;
  214.                                                End;
  215.                                              1:Begin
  216.                                                If Peds[I,2]<Y
  217.                                                   Then Peds[I,4]:=Random(4)-2
  218.                                                   Else Peds[I,4]:=Random(4)-1;
  219.                                                If Peds[I,4]=-2 then Peds[I,4]:=-1;
  220.                                                If Peds[I,4]= 2 then Peds[I,4]:= 1;
  221.                                                End;
  222.                                              End;
  223.                                      Until (Peds[I,3]<>0) or (Peds[I,4]<>0);
  224.                              Plot(Peds[I,1],Peds[I,2], 0);
  225.                              Peds[I,1] := Peds[I,1]+Peds[I,3];
  226.                              Peds[I,2] := Peds[I,2]+Peds[I,4];
  227.                              If Peds[I,1]<5   Then Peds[I,1] := 315;
  228.                              If Peds[I,1]>315 Then Peds[I,1] := 5;
  229.                              If Peds[I,2]<15  Then Peds[I,2] := 195;
  230.                              If Peds[I,2]>195 Then Peds[I,2] := 15;
  231.                              Plot(Peds[I,1],Peds[I,2], 3);
  232.                              End;
  233.          Case Dir of
  234.               1:Begin Y:=Y-1;         PutPic(CarN, X,Y) End;
  235.               2:Begin Y:=Y-1; X:=X+1; PutPic(CarNE,X,Y) End;
  236.               3:Begin         X:=X+1; PutPic(CarE ,X,Y) End;
  237.               4:Begin Y:=Y+1; X:=X+1; PutPic(CarSE,X,Y) End;
  238.               5:Begin Y:=Y+1;         PutPic(CarS ,X,Y) End;
  239.               6:Begin Y:=Y+1; X:=X-1; PutPic(CarSW,X,Y) End;
  240.               7:Begin         X:=X-1; PutPic(CarW ,X,Y) End;
  241.               8:Begin Y:=Y-1; X:=X-1; PutPic(CarNW,X,Y) End;
  242.              End; {case}
  243.          If KeyPressed
  244.             Then Begin
  245.                  Read(KBD,c);
  246.                  Case C of
  247.                      '4':dir:=Dir-1;
  248.                      '5':dir:=Dir+4;
  249.                      '6':dir:=Dir+1;
  250.                      End;
  251.                  End;
  252.          If X>=303 then Dir := Dir+4;
  253.          if X<=1   then Dir := Dir+4;
  254.          If Y<=24  then Dir := Dir+4;
  255.          If Y>=198 then Dir := Dir+4;
  256.          If Dir<1 Then Dir:=Dir+8;
  257.          If dir>8 Then Dir:=Dir-8;
  258.          If KeyChk(ScrLok) Then Delay(300);
  259.      until (C=#27) or (Dead=10);
  260.      For I := 200 to 1000 do
  261.          Begin
  262.          Sound(I);
  263.          Delay(1);
  264.          End;
  265.      For I := 1000 downto 10 do
  266.          Begin
  267.          Sound(I);
  268.          Delay(1);
  269.          End;
  270.      NoSound;
  271.      TextMode;
  272.      Writeln;
  273.      Writeln('                Drunk driving is just murder on our roads!');
  274.      KeySet(NumLok,False);
  275. End.
  276.